home *** CD-ROM | disk | FTP | other *** search
/ X User Tools / X User Tools (O'Reilly and Associates)(1994).ISO / sun4c / archive / tcltk.z / tcltk / slib / tk / prolog.ps < prev    next >
Text File  |  1994-09-20  |  6KB  |  204 lines
  1. % This file contains the standard Postscript prolog used when
  2. % generating Postscript from canvas widgets.
  3. %
  4. % $Header: /user6/ouster/wish/library/RCS/prolog.ps,v 1.6 93/04/01 14:03:52 ouster Exp $ SPRITE (Berkeley);
  5.  
  6. %%BeginProlog
  7. 50 dict begin
  8.  
  9. % The definitions below just define all of the variables used in
  10. % any of the procedures here.  This is needed for obscure reasons
  11. % explained on p. 716 of the Postscript manual (Section H.2.7,
  12. % "Initializing Variables," in the section on Encapsulated Postscript).
  13.  
  14. /baseline 0 def
  15. /stipimage 0 def
  16. /height 0 def
  17. /justify 0 def
  18. /maxwidth 0 def
  19. /spacing 0 def
  20. /stipple 0 def
  21. /strings 0 def
  22. /xoffset 0 def
  23. /yoffset 0 def
  24. /tmpstip null def
  25. /encoding {ISOLatin1Encoding} def
  26.  
  27. % Override setfont to automatically encode the font in the style defined by 
  28. % by 'encoding' (ISO Latin1 by default).
  29.  
  30. systemdict /encodefont known {
  31.     /realsetfont /setfont load def
  32.     /setfont {
  33.     encoding encodefont realsetfont
  34.     } def
  35. } if
  36.  
  37. % desiredSize EvenPixels closestSize
  38. %
  39. % The procedure below is used for stippling.  Given the optimal size
  40. % of a dot in a stipple pattern in the current user coordinate system,
  41. % compute the closest size that is an exact multiple of the device's
  42. % pixel size.  This allows stipple patterns to be displayed without
  43. % aliasing effects.
  44.  
  45. /EvenPixels {
  46.     % Compute exact number of device pixels per stipple dot.
  47.     dup 0 matrix currentmatrix dtransform
  48.     dup mul exch dup mul add sqrt
  49.  
  50.     % Round to an integer, make sure the number is at least 1, and compute
  51.     % user coord distance corresponding to this.
  52.     dup round dup 1 lt {pop 1} if
  53.     exch div mul
  54. } bind def
  55.  
  56. % width height string filled StippleFill --
  57. %
  58. % Given a path and other graphics information already set up, this
  59. % procedure will fill the current path in a stippled fashion.  "String"
  60. % contains a proper image description of the stipple pattern and
  61. % "width" and "height" give its dimensions.  If "filled" is true then
  62. % it means that the area to be stippled is gotten by filling the
  63. % current path (e.g. the interior of a polygon); if it's false, the
  64. % area is gotten by stroking the current path (e.g. a wide line).
  65. % Each stipple dot is assumed to be about one unit across in the
  66. % current user coordinate system.
  67.  
  68. /StippleFill {
  69.     % Turn the path into a clip region that we can then cover with
  70.     % lots of images corresponding to the stipple pattern.  Warning:
  71.     % some Postscript interpreters get errors during strokepath for
  72.     % dashed lines.  If this happens, turn off dashes and try again.
  73.  
  74.     1 index /tmpstip exch def %% Works around NeWSprint bug
  75.  
  76.     gsave
  77.     {eoclip}
  78.     {{strokepath} stopped {grestore gsave [] 0 setdash strokepath} if clip}
  79.     ifelse
  80.  
  81.     % Change the scaling so that one user unit in user coordinates
  82.     % corresponds to the size of one stipple dot.
  83.     1 EvenPixels dup scale
  84.  
  85.     % Compute the bounding box occupied by the path (which is now
  86.     % the clipping region), and round the lower coordinates down
  87.     % to the nearest starting point for the stipple pattern.
  88.  
  89.     pathbbox
  90.     4 2 roll
  91.     5 index div cvi 5 index mul 4 1 roll
  92.     6 index div cvi 6 index mul 3 2 roll
  93.  
  94.     % Stack now: width height string y1 y2 x1 x2
  95.     % Below is a doubly-nested for loop to iterate across this area
  96.     % in units of the stipple pattern size, going up columns then
  97.     % across rows, blasting out a stipple-pattern-sized rectangle at
  98.     % each position
  99.  
  100.     6 index exch {
  101.     2 index 5 index 3 index {
  102.         % Stack now: width height string y1 y2 x y
  103.  
  104.         gsave
  105.         1 index exch translate
  106.         5 index 5 index true matrix tmpstip imagemask
  107.         grestore
  108.     } for
  109.     pop
  110.     } for
  111.     pop pop pop pop pop
  112.     grestore
  113.     newpath
  114. } bind def
  115.  
  116. % -- AdjustColor --
  117. % Given a color value already set for output by the caller, adjusts
  118. % that value to a grayscale or mono value if requested by the CL
  119. % variable.
  120.  
  121. /AdjustColor {
  122.     CL 2 lt {
  123.     currentgray
  124.     CL 0 eq {
  125.         .5 lt {0} {1} ifelse
  126.     } if
  127.     setgray
  128.     } if
  129. } bind def
  130.  
  131. % x y strings spacing xoffset yoffset justify stipple stipimage DrawText --
  132. % This procedure does all of the real work of drawing text.  The
  133. % color and font must already have been set by the caller, and the
  134. % following arguments must be on the stack:
  135. %
  136. % x, y -    Coordinates at which to draw text.
  137. % strings -    An array of strings, one for each line of the text item,
  138. %        in order from top to bottom.
  139. % spacing -    Spacing between lines.
  140. % xoffset -    Horizontal offset for text bbox relative to x and y: 0 for
  141. %        nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.
  142. % yoffset -    Vertical offset for text bbox relative to x and y: 0 for
  143. %        nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.
  144. % justify -    0 for left justification, 0.5 for center, 1 for right justify.
  145. % stipple -    Boolean value indicating whether or not text is to be
  146. %        drawn in stippled fashion.
  147. % stipimage -    Image for stippling, if stipple is True.
  148. %
  149. % Also, when this procedure is invoked, the color and font must already
  150. % have been set for the text.
  151.  
  152. /DrawText {
  153.     /stipimage exch def
  154.     /stipple exch def
  155.     /justify exch def
  156.     /yoffset exch def
  157.     /xoffset exch def
  158.     /spacing exch def
  159.     /strings exch def
  160.  
  161.     % First scan through all of the text to find the widest line.
  162.  
  163.     /maxwidth 0 def
  164.     strings {
  165.     stringwidth pop
  166.     dup maxwidth gt {/maxwidth exch def} {pop} ifelse
  167.     newpath
  168.     } forall
  169.  
  170.     % Compute the baseline offset and the actual font height.
  171.  
  172.     0 0 moveto (TXygqPZ) false charpath
  173.     pathbbox dup /baseline exch def
  174.     exch pop exch sub /height exch def pop
  175.     newpath
  176.  
  177.     % Translate coordinates first so that the origin is at the upper-left
  178.     % corner of the text's bounding box. Remember that x and y for
  179.     % positioning are still on the stack.
  180.  
  181.     translate
  182.     maxwidth xoffset mul
  183.     strings length 1 sub spacing mul height add yoffset mul translate
  184.  
  185.     % Now use the baseline and justification information to translate so
  186.     % that the origin is at the baseline and positioning point for the
  187.     % first line of text.
  188.  
  189.     justify maxwidth mul baseline neg translate
  190.  
  191.     % Iterate over each of the lines to output it.  For each line,
  192.     % compute its width again so it can be properly justified, then
  193.     % display it.
  194.  
  195.     strings {
  196.     dup stringwidth pop
  197.     justify neg mul 0 moveto
  198.     show
  199.     0 spacing neg translate
  200.     } forall
  201. } bind def
  202.  
  203. %%EndProlog
  204.